perm filename GTREE.LSP[206,JMC] blob
sn#075772 filedate 1973-12-04 generic text, type T, neo UTF8
(DEFPROP PRFFNS
(PRFFNS PRFMAX PRFMIN RECTIFY COMMONTAIL COMMONHEAD)
VALUE)
(DEFPROP PRFMAX
(LAMBDA(U PRMAX PRMIN ALPHA BETA)
(COND
((NULL U) (LIST ALPHA PRMAX PRMIN))
(T
((LAMBDA(S)
(COND
((NOT (GREATERP (CAR S) ALPHA))
(PRFMAX (CDR U)
PRMAX
(CONS (CONS (EXT (CAR U)) (CADDR S)) PRMIN)
ALPHA
BETA))
((LESSP (CAR S) BETA)
(PRFMAX (CDR U)
(CONS (EXT (CAR U)) (CADR S))
(CONS (CONS (EXT (CAR U)) (CADDR S)) PRMIN)
(CAR S)
BETA))
(T (LIST BETA (CONS (EXT (CAR U)) (CADR S)) NIL))))
(COND
((TER (RECTIFY (CAR U)) ALPHA BETA)
((LAMBDA (V) (LIST V (LIST V) (LIST V)))
(IMVAL (RECTIFY (CAR U)))))
(T
(PRFMIN (SUCCESSORS (RECTIFY (CAR U)))
NIL
(CONS BETA (QUOTE BETA-CUTOFF))
ALPHA
BETA)))))))
EXPR)
(DEFPROP PRFMIN
(LAMBDA(U PRMAX PRMIN ALPHA BETA)
(COND
((NULL U) (LIST BETA PRMAX PRMIN))
(T
((LAMBDA(S)
(COND
((NOT (GREATERP (CAR S) ALPHA))
(LIST ALPHA NIL (CONS (EXT (CAR U)) (CADDR S))))
((LESSP (CAR S) BETA)
(PRFMIN (CDR U)
(CONS (CONS (EXT (CAR U)) (CADR S)) PRMAX)
(CONS (EXT (CAR U)) (CADDR S))
ALPHA
(CAR S)))
(T
(PRFMIN (CDR U)
(CONS (CONS (EXT (CAR U)) (CADR S)) PRMAX)
PRMIN
ALPHA
BETA))))
(COND
((TER (RECTIFY (CAR U)) ALPHA BETA)
((LAMBDA (V) (LIST V (LIST V) (LIST V)))
(IMVAL (RECTIFY (CAR U)))))
(T
(PRFMAX (SUCCESSORS (RECTIFY (CAR U)))
(CONS ALPHA (QUOTE ALPHA-CUTOFF))
NIL
ALPHA
BETA)))))))
EXPR)
(DEFPROP RECTIFY
(LAMBDA(P)
(PROG (Z Q)
(SETQ Q (COMMONTAIL P P1))
L1 (COND ((EQUAL Q P1) (GO L2)))
(REVERT)
(GO L1)
L2 (SETQ Z (LISTSUBT P P1))
L3 (COND ((NULL Z) (RETURN P)))
(UPDATE (CAR Z))
(SETQ Z (CDR Z))
(GO L3)))
EXPR)
(DEFPROP COMMONTAIL
(LAMBDA (U V) (REVERSE (COMMONHEAD (REVERSE U) (REVERSE V))))
EXPR)
(DEFPROP COMMONHEAD
(LAMBDA(U V)
(COND ((OR (NULL U) (NULL V) (NOT (EQUAL (CAR U) (CAR V)))) NIL)
(T (CONS (CAR U) (COMMONHEAD (CDR U) (CDR V))))))
EXPR)